home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 February: Tool Chest / Dev.CD Feb 95 / Dev.CD Feb 95.toast / Tool Chest / Development Tools & Languages / Dylan Related / Mindy-1.1 (sources only) / mindy-1.1 / interp / load.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-08-23  |  27.3 KB  |  1,213 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: load.c,v 1.22 94/08/21 00:41:53 wlott Exp $
  27. *
  28. * This file implements the loader.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include <string.h>
  33. #include <errno.h>
  34. #include <sys/file.h>
  35. #include <sys/param.h>
  36. #include <ctype.h>
  37. #ifdef MACH
  38. extern int open(const void *path, int flags, int mode);
  39. extern int close(int fd);
  40. extern int read(int fd, void *ptr, int bytes);
  41. extern int access(const void *path, int flags);
  42. #endif
  43. #if defined(hpux) || defined(__osf__) || defined(sgi) || defined(linux) || defined(ultrix) || defined(sparc)
  44. #define pause buttplug
  45. #include <unistd.h>
  46. #undef pause
  47. #endif
  48. #ifdef sgi
  49. #include <sys/types.h>
  50. #include <sys/stat.h>
  51. #include <fcntl.h>
  52. #include <stdlib.h>
  53. #endif
  54. #ifdef linux
  55. #include <stdlib.h>
  56. #endif
  57. #ifdef sparc
  58. #include <stdlib.h>
  59. extern char *sys_errlist[];
  60. #endif
  61.  
  62. #include "mindy.h"
  63. #include "bool.h"
  64. #include "list.h"
  65. #include "module.h"
  66. #include "str.h"
  67. #include "sym.h"
  68. #include "num.h"
  69. #include "thread.h"
  70. #include "interp.h"
  71. #include "func.h"
  72. #include "obj.h"
  73. #include "gc.h"
  74. #include "class.h"
  75. #include "char.h"
  76. #include "driver.h"
  77. #include "debug.h"
  78. #include "instance.h"
  79. #include "vec.h"
  80. #include "error.h"
  81. #include "../comp/fileops.h"
  82. #include "config.h"
  83. #include "load.h"
  84.  
  85. #if defined(MACH) || defined(hpux)
  86. extern char *strerror(int errnum);
  87. extern char *getenv(char *name);
  88. #endif
  89.  
  90. #define BUFFER_SIZE 4096
  91.  
  92. struct form {
  93.     obj_t method;
  94.     struct form *next;
  95. };
  96.  
  97. struct queue {
  98.     struct form *head;
  99.     struct form **tail;
  100. };
  101.  
  102. struct load_state {
  103.     struct queue everything;
  104.     struct queue classes;
  105.     struct queue top_level_forms;
  106. };
  107.  
  108. static struct load_state State;
  109.  
  110. struct load_info {
  111.     char *name;
  112.     int fd;
  113.     unsigned char *buffer, *ptr, *end;
  114.     obj_t *table, *table_end;
  115.     int next_handle;
  116.     boolean swap_bytes;
  117.     boolean done;
  118.     struct library *library;
  119.     struct module *module;
  120.     obj_t mtime;
  121.     obj_t source_file;
  122. };
  123.  
  124. static obj_t (*opcodes[256])(struct load_info *info);
  125.  
  126.  
  127. /* Utility routines. */
  128.  
  129. static int safe_read(struct load_info *info, void *ptr, int bytes)
  130. {
  131.     int count = read(info->fd, ptr, bytes);
  132.  
  133.     if (count < 0)
  134.     error("error loading %s: %s",
  135.           make_string(info->name),
  136. #ifndef sparc
  137.           make_string(strerror(errno)));
  138. #else
  139.               make_string(sys_errlist[errno]));
  140. #endif
  141.     if (count == 0)
  142.     error("premature EOF loading %s", make_string(info->name));
  143.  
  144.     return count;
  145. }
  146.  
  147. static void read_bytes(struct load_info *info, void *ptr, int bytes)
  148. {
  149.     int count = info->end - info->ptr;
  150.  
  151.     while (1) {
  152.     if (bytes <= count) {
  153.         memcpy(ptr, info->ptr, bytes);
  154.         info->ptr += bytes;
  155.         return;
  156.     }
  157.  
  158.     memcpy(ptr, info->ptr, count);
  159.     ptr += count;
  160.     bytes -= count;
  161.     info->ptr = info->end = info->buffer;
  162.  
  163.     while (bytes > BUFFER_SIZE) {
  164.         count = safe_read(info, ptr, bytes);
  165.         ptr += count;
  166.         bytes -= count;
  167.     }
  168.     
  169.     if (bytes == 0)
  170.         return;
  171.     
  172.     count = safe_read(info, info->buffer, BUFFER_SIZE);
  173.     info->end = info->buffer + count;
  174.     }
  175. }
  176.  
  177. static void read_ordered_bytes(struct load_info *info, void *ptr, int bytes)
  178. {
  179.     if (info->swap_bytes) {
  180.     unsigned char *dst = (unsigned char *)ptr + bytes;
  181.     unsigned char *src = info->ptr;
  182.     unsigned char *end = info->end;
  183.  
  184.     while (end-src < dst-(unsigned char *)ptr) {
  185.         while (src < end)
  186.         *--dst = *src++;
  187.         src = info->buffer;
  188.         end = src + safe_read(info, src, BUFFER_SIZE);
  189.     }
  190.     while (dst > (unsigned char *)ptr)
  191.         *--dst = *src++;
  192.     info->ptr = src;
  193.     info->end = end;
  194.     }
  195.     else
  196.     read_bytes(info, ptr, bytes);
  197. }
  198.  
  199. static int read_byte(struct load_info *info)
  200. {
  201.     unsigned char *ptr = info->ptr;
  202.  
  203.     if (ptr == info->end) {
  204.     ptr = info->buffer;
  205.     info->end = ptr + safe_read(info, ptr, BUFFER_SIZE);
  206.     }
  207.     info->ptr = ptr+1;
  208.  
  209.     return *ptr;
  210. }
  211.  
  212. static void unread_byte(struct load_info *info)
  213. {
  214.     if (info->ptr == info->buffer)
  215.     lose("unread_byte used while buffer empty.");
  216.  
  217.     info->ptr--;
  218. }
  219.  
  220. static unsigned short read_ushort(struct load_info *info)
  221. {
  222.     unsigned short res;
  223.  
  224.     read_ordered_bytes(info, &res, sizeof(res));
  225.  
  226.     return res;
  227. }
  228.  
  229. static short read_short(struct load_info *info)
  230. {
  231.     short res;
  232.  
  233.     read_ordered_bytes(info, &res, sizeof(res));
  234.  
  235.     return res;
  236. }
  237.  
  238. static int read_int(struct load_info *info)
  239. {
  240.     int res;
  241.  
  242.     read_ordered_bytes(info, &res, sizeof(res));
  243.  
  244.     return res;
  245. }
  246.  
  247. static long read_long(struct load_info *info)
  248. {
  249.     long res;
  250.  
  251.     read_ordered_bytes(info, &res, sizeof(res));
  252.  
  253.     return res;
  254. }
  255.  
  256. static obj_t read_thing(struct load_info *info)
  257. {
  258.     int byte = read_byte(info);
  259.  
  260.     return (*opcodes[byte])(info);
  261. }
  262.  
  263.  
  264. /* Actual loader operations. */
  265.  
  266. static obj_t fop_flame(struct load_info *info)
  267. {
  268.     lose("Bogus opcode in %s\n", info->name);
  269.     return NULL;
  270. }
  271.  
  272. static void check_size(struct load_info *info, int desired, char *what)
  273. {
  274.     int bytes = read_byte(info);
  275.  
  276.     if (bytes != desired)
  277.     error("Wrong sized %s in %s: should be %= but is %=",
  278.           make_string(what), make_string(info->name),
  279.           make_fixnum(desired), make_fixnum(bytes));
  280. }
  281.  
  282. static obj_t fop_header(struct load_info *info)
  283. {
  284.     short x;
  285.     long magic;
  286.     int major_version, minor_version;
  287.  
  288.     major_version = read_byte(info);
  289.     minor_version = read_byte(info);
  290.  
  291.     if (major_version < file_MajorVersion)
  292.     error("Obsolete .dbc file: %s", make_string(info->name));
  293.     if (major_version > file_MajorVersion)
  294.     error("Obsolete version of Mindy for %s", make_string(info->name));
  295.     if (minor_version < file_MinorVersion)
  296.     error("Obsolete .dbc file: %s", make_string(info->name));
  297.  
  298.     check_size(info, sizeof(short), "short");
  299.     check_size(info, sizeof(int), "int");
  300.     check_size(info, sizeof(long), "long");
  301.     check_size(info, sizeof(float), "float");
  302.     check_size(info, sizeof(double), "double");
  303.     check_size(info, sizeof(long double), "long double");
  304.  
  305.     read_bytes(info, &x, sizeof(short));
  306.     info->swap_bytes = (x != 1);
  307.  
  308.     magic = read_int(info);
  309.  
  310.     if (magic != dbc_MagicNumber)
  311.     error("Invalid .dbc file: %s", make_string(info->name));
  312.     
  313.     return obj_False;
  314. }
  315.  
  316. static int next_handle(struct load_info *info)
  317. {
  318.     int res = info->next_handle++;
  319.     return res;
  320. }
  321.  
  322. static obj_t store(struct load_info *info, obj_t value, int handle)
  323. {
  324.     int size = info->table_end - info->table;
  325.  
  326.     if (handle >= size) {
  327.     if (handle < 16*1024) {
  328.         if (size == 0)
  329.         size = 1024;
  330.         while (handle >= size)
  331.         size *= 2;
  332.     }
  333.     else
  334.         size = ((handle + 16*1024-1) / (16*1024)) * 16*1024;
  335.     if (info->table)
  336.         info->table = realloc(info->table, sizeof(obj_t) * size);
  337.     else
  338.         info->table = malloc(sizeof(obj_t) * size);
  339.     info->table_end = info->table + size;
  340.     }
  341.  
  342.     info->table[handle] = value;
  343.  
  344.     return value;
  345. }
  346.  
  347. static obj_t fop_store(struct load_info *info)
  348. {
  349.     int handle = next_handle(info);
  350.     return(store(info, read_thing(info), handle));
  351. }
  352.  
  353. static obj_t ref(struct load_info *info, int index)
  354. {
  355.     int table_size = info->table_end - info->table;
  356.  
  357.     if (index < 0 || index >= table_size)
  358.     lose("Bogus ref index %d, should be >= 0 and < %d\n",
  359.          index, table_size);
  360.  
  361.     return info->table[index];
  362. }
  363.  
  364. static obj_t fop_short_ref(struct load_info *info)
  365. {
  366.     return ref(info, read_ushort(info));
  367. }
  368.  
  369. static obj_t fop_ref(struct load_info *info)
  370. {
  371.     return ref(info, read_int(info));
  372. }
  373.  
  374. static obj_t fop_false(struct load_info *info)
  375. {
  376.     return obj_False;
  377. }
  378.  
  379. static obj_t fop_true(struct load_info *info)
  380. {
  381.     return obj_True;
  382. }
  383.  
  384. static obj_t fop_unbound(struct load_info *info)
  385. {
  386.     return obj_Unbound;
  387. }
  388.  
  389. static obj_t fop_signed_byte(struct load_info *info)
  390. {
  391.     return make_fixnum((signed char)read_byte(info));
  392. }
  393.  
  394. static obj_t fop_signed_short(struct load_info *info)
  395. {
  396.     return make_fixnum(read_short(info));
  397. }
  398.  
  399. static obj_t fop_signed_int(struct load_info *info)
  400. {
  401.     return make_fixnum(read_int(info));
  402. }
  403.  
  404. static obj_t fop_signed_long(struct load_info *info)
  405. {
  406.     return make_fixnum(read_long(info));
  407. }
  408.  
  409. static obj_t fop_char(struct load_info *info)
  410. {
  411.     return int_char(read_byte(info));
  412. }
  413.  
  414. static obj_t fop_single_float(struct load_info *info)
  415. {
  416.     float f;
  417.  
  418.     read_ordered_bytes(info, &f, 4);
  419.  
  420.     return make_single(f);
  421. }
  422.  
  423. static obj_t fop_double_float(struct load_info *info)
  424. {
  425.     double d;
  426.  
  427.     read_ordered_bytes(info, &d, sizeof(d));
  428.  
  429.     return make_double(d);
  430. }
  431.  
  432. static obj_t fop_extended_float(struct load_info *info)
  433. {
  434.     long double d;
  435.  
  436.     read_ordered_bytes(info, &d, sizeof(d));
  437.  
  438.     return make_extended(d);
  439. }
  440.  
  441. static obj_t fop_short_string(struct load_info *info)
  442. {
  443.     int len = read_byte(info);
  444.     obj_t res = alloc_string(len);
  445.  
  446.     read_bytes(info, string_chars(res), len);
  447.  
  448.     return res;
  449. }
  450.  
  451. static obj_t fop_string(struct load_info *info)
  452. {
  453.     int len = read_int(info);
  454.     obj_t res = alloc_string(len);
  455.  
  456.     read_bytes(info, string_chars(res), len);
  457.  
  458.     return res;
  459. }
  460.  
  461. static obj_t fop_short_symbol(struct load_info *info)
  462. {
  463.     return store(info, symbol(string_chars(fop_short_string(info))),
  464.          next_handle(info));
  465. }
  466.  
  467. static obj_t fop_symbol(struct load_info *info)
  468. {
  469.     return store(info, symbol(string_chars(fop_string(info))),
  470.          next_handle(info));
  471. }
  472.  
  473. static obj_t fop_nil(struct load_info *info)
  474. {
  475.     return obj_Nil;
  476. }
  477.  
  478. static obj_t read_list(struct load_info *info, int len, boolean dotted)
  479. {
  480.     obj_t result, *prev;
  481.  
  482.     prev = &result;
  483.  
  484.     while (len-- > 0) {
  485.     obj_t new = pair(read_thing(info), obj_False);
  486.     *prev = new;
  487.     prev = &TAIL(new);
  488.     }
  489.  
  490.     if (dotted)
  491.     *prev = read_thing(info);
  492.     else
  493.     *prev = obj_Nil;
  494.  
  495.     return result;
  496. }
  497.  
  498. static obj_t fop_list1(struct load_info *info)
  499. {
  500.     return pair(read_thing(info), obj_Nil);
  501. }
  502.  
  503. static obj_t fop_list2(struct load_info *info)
  504. {
  505.     return read_list(info, 2, FALSE);
  506. }
  507.  
  508. static obj_t fop_list3(struct load_info *info)
  509. {
  510.     return read_list(info, 3, FALSE);
  511. }
  512.  
  513. static obj_t fop_list4(struct load_info *info)
  514. {
  515.     return read_list(info, 4, FALSE);
  516. }
  517.  
  518. static obj_t fop_list5(struct load_info *info)
  519. {
  520.     return read_list(info, 5, FALSE);
  521. }
  522.  
  523. static obj_t fop_list6(struct load_info *info)
  524. {
  525.     return read_list(info, 6, FALSE);
  526. }
  527.  
  528. static obj_t fop_list7(struct load_info *info)
  529. {
  530.     return read_list(info, 7, FALSE);
  531. }
  532.  
  533. static obj_t fop_list8(struct load_info *info)
  534. {
  535.     return read_list(info, 8, FALSE);
  536. }
  537.  
  538. static obj_t fop_listn(struct load_info *info)
  539. {
  540.     return read_list(info, read_byte(info)+9, FALSE);
  541. }
  542.  
  543. static obj_t fop_dotted_list1(struct load_info *info)
  544. {
  545.     return read_list(info, 1, TRUE);
  546. }
  547.  
  548. static obj_t fop_dotted_list2(struct load_info *info)
  549. {
  550.     return read_list(info, 2, TRUE);
  551. }
  552.  
  553. static obj_t fop_dotted_list3(struct load_info *info)
  554. {
  555.     return read_list(info, 3, TRUE);
  556. }
  557.  
  558. static obj_t fop_dotted_list4(struct load_info *info)
  559. {
  560.     return read_list(info, 4, TRUE);
  561. }
  562.  
  563. static obj_t fop_dotted_list5(struct load_info *info)
  564. {
  565.     return read_list(info, 5, TRUE);
  566. }
  567.  
  568. static obj_t fop_dotted_list6(struct load_info *info)
  569. {
  570.     return read_list(info, 6, TRUE);
  571. }
  572.  
  573. static obj_t fop_dotted_list7(struct load_info *info)
  574. {
  575.     return read_list(info, 7, TRUE);
  576. }
  577.  
  578. static obj_t fop_dotted_list8(struct load_info *info)
  579. {
  580.     return read_list(info, 8, TRUE);
  581. }
  582.  
  583. static obj_t fop_dotted_listn(struct load_info *info)
  584. {
  585.     return read_list(info, read_byte(info)+9, TRUE);
  586. }
  587.  
  588. static obj_t read_vector(struct load_info *info, int len)
  589. {
  590.     obj_t res = make_vector(len, NULL);
  591.     int i;
  592.  
  593.     for (i = 0; i < len; i++)
  594.     SOVEC(res)->contents[i] = read_thing(info);
  595.  
  596.     return res;
  597. }
  598.  
  599. static obj_t fop_vector0(struct load_info *info)
  600. {
  601.     return read_vector(info, 0);
  602. }
  603.  
  604. static obj_t fop_vector1(struct load_info *info)
  605. {
  606.     return read_vector(info, 1);
  607. }
  608.  
  609. static obj_t fop_vector2(struct load_info *info)
  610. {
  611.     return read_vector(info, 2);
  612. }
  613.  
  614. static obj_t fop_vector3(struct load_info *info)
  615. {
  616.     return read_vector(info, 3);
  617. }
  618.  
  619. static obj_t fop_vector4(struct load_info *info)
  620. {
  621.     return read_vector(info, 4);
  622. }
  623.  
  624. static obj_t fop_vector5(struct load_info *info)
  625. {
  626.     return read_vector(info, 5);
  627. }
  628.  
  629. static obj_t fop_vector6(struct load_info *info)
  630. {
  631.     return read_vector(info, 6);
  632. }
  633.  
  634. static obj_t fop_vector7(struct load_info *info)
  635. {
  636.     return read_vector(info, 7);
  637. }
  638.  
  639. static obj_t fop_vector8(struct load_info *info)
  640. {
  641.     return read_vector(info, 8);
  642. }
  643.  
  644. static obj_t fop_vectorn(struct load_info *info)
  645. {
  646.     int len = read_byte(info);
  647.  
  648.     if (len == 255)
  649.     len = read_int(info)+9+254+(1<<16);
  650.     else if (len == 254)
  651.     len = read_ushort(info)+9+254;
  652.     else
  653.     len += 9;
  654.  
  655.     return read_vector(info, len);
  656. }
  657.  
  658. static obj_t fop_value_cell(struct load_info *info)
  659. {
  660.     return rawptr_obj(find_variable(info->module, read_thing(info), FALSE, TRUE));
  661. }
  662.  
  663. static obj_t fop_writable_value_cell(struct load_info *info)
  664. {
  665.     return rawptr_obj(find_variable(info->module, read_thing(info), TRUE, TRUE));
  666. }
  667.  
  668. static obj_t fop_builtin_value_cell(struct load_info *info)
  669. {
  670.     return rawptr_obj(find_variable(module_BuiltinStuff, read_thing(info),
  671.                     FALSE, TRUE));
  672. }
  673.  
  674. static obj_t fop_builtin_writable_value_cell(struct load_info *info)
  675. {
  676.     return rawptr_obj(find_variable(module_BuiltinStuff, read_thing(info),
  677.                     TRUE, TRUE));
  678. }
  679.  
  680. static obj_t read_component(struct load_info *info, int nconst, int nbytes)
  681. {
  682.     obj_t debug_name = read_thing(info);
  683.     int frame_size = fixnum_value(read_thing(info));
  684.     obj_t debug_info = read_thing(info);
  685.     obj_t res = make_component(debug_name, frame_size, info->mtime,
  686.                    info->source_file, debug_info, nconst, nbytes);
  687.     int i;
  688.  
  689.     for (i = 0; i < nconst; i++)
  690.     obj_ptr(struct component *, res)->constant[i] = read_thing(info);
  691.     read_bytes(info, &obj_ptr(struct component *, res)->constant[nconst],
  692.            nbytes);
  693.  
  694.     return res;
  695. }
  696.  
  697. static obj_t fop_short_component(struct load_info *info)
  698. {
  699.     int nconst = read_byte(info);
  700.     int nbytes = read_ushort(info);
  701.  
  702.     return read_component(info, nconst, nbytes);
  703. }
  704.  
  705. static obj_t fop_component(struct load_info *info)
  706. {
  707.     int nconst = read_int(info);
  708.     int nbytes = read_int(info);
  709.  
  710.     return read_component(info, nconst, nbytes);
  711. }
  712.  
  713. static obj_t read_method(struct load_info *info, int param_info,
  714.              int nclosure_vars)
  715. {
  716.     boolean restp = param_info & 1;
  717.     boolean all_keys = param_info & 2;
  718.     int nkeys = (param_info>>2)-1;
  719.     obj_t keys;
  720.  
  721.     if (nkeys == -1)
  722.     keys = obj_False;
  723.     else {
  724.     obj_t *prev = &keys;
  725.     while (nkeys-- > 0) {
  726.         obj_t key = read_thing(info);
  727.         obj_t def = read_thing(info);
  728.         obj_t keyinfo = pair(key, def);
  729.         obj_t new = list1(keyinfo);
  730.         *prev = new;
  731.         prev = &TAIL(new);
  732.     }
  733.     *prev = obj_Nil;
  734.     }
  735.  
  736.     return make_method_info(restp, keys, all_keys, read_thing(info),
  737.                 nclosure_vars);
  738. }
  739.  
  740. static obj_t fop_short_method(struct load_info *info)
  741. {
  742.     int param_info = read_byte(info);
  743.     int nclosure_vars = read_byte(info);
  744.  
  745.     return read_method(info, param_info, nclosure_vars);
  746. }
  747.  
  748. static obj_t fop_method(struct load_info *info)
  749. {
  750.     int param_info = read_int(info);
  751.     int nclosure_vars = read_int(info);
  752.  
  753.     return read_method(info, param_info, nclosure_vars);
  754. }
  755.  
  756. static obj_t fop_in_library(struct load_info *info)
  757. {
  758.     obj_t name = read_thing(info);
  759.     info->library = find_library(name, TRUE);
  760.     if (CurLibrary == NULL)
  761.     CurLibrary = info->library;
  762.     return name;
  763. }
  764.  
  765. static obj_t fop_in_module(struct load_info *info)
  766. {
  767.     obj_t name = read_thing(info);
  768.     info->module = find_module(info->library, name, TRUE, TRUE);
  769.     if (CurLibrary == info->library && CurModule == NULL)
  770.     CurModule = info->module;
  771.     return name;
  772. }
  773.  
  774. static obj_t fop_source_file(struct load_info *info)
  775. {
  776.     info->mtime = read_thing(info);
  777.     info->source_file = read_thing(info);
  778.     return info->source_file;
  779. }
  780.  
  781. static obj_t make_top_level_method(obj_t component)
  782. {
  783.     obj_t method_info = make_method_info(FALSE, obj_False, FALSE,
  784.                      component, 0);
  785.     return make_byte_method(method_info, obj_Nil, obj_Nil, obj_ObjectClass,
  786.                 NULL);
  787. }
  788.  
  789. static obj_t queue_form(struct queue *queue, obj_t component)
  790. {
  791.     struct form *new = malloc(sizeof(*new));
  792.  
  793.     new->method = make_top_level_method(component);
  794.     new->next = NULL;
  795.  
  796.     *queue->tail = new;
  797.     queue->tail = &new->next;
  798.  
  799.     return function_debug_name_or_self(new->method);
  800. }
  801.  
  802. static obj_t fop_top_level_form(struct load_info *info)
  803. {
  804.     return queue_form(&State.top_level_forms, read_thing(info));
  805. }
  806.  
  807. static obj_t fop_define_class(struct load_info *info)
  808. {
  809.     obj_t name = read_thing(info);
  810.     struct variable *var;
  811.     obj_t slot;
  812.  
  813.     define_variable(info->module, name, var_Class);
  814.     var = find_variable(info->module, name, FALSE, TRUE);
  815.  
  816.     if (var->value != obj_Unbound)
  817.     error("Can't both define class and define method %=", name);
  818.  
  819.     var->value = make_defined_class(name, info->library);
  820.  
  821.     while ((slot = read_thing(info)) != obj_False)
  822.     define_variable(info->module, slot, var_Method);
  823.  
  824.     queue_form(&State.classes, read_thing(info));
  825.     queue_form(&State.top_level_forms, read_thing(info));
  826.  
  827.     return name;
  828. }
  829.  
  830. static obj_t fop_define_generic(struct load_info *info)
  831. {
  832.     obj_t name = read_thing(info);
  833.     obj_t tlf = read_thing(info);
  834.  
  835.     define_variable(info->module, name, var_GenericFunction);
  836.     queue_form(&State.top_level_forms, tlf);
  837.  
  838.     return name;
  839. }
  840.  
  841. static obj_t fop_define_method(struct load_info *info)
  842. {
  843.     obj_t name = read_thing(info);
  844.     obj_t tlf = read_thing(info);
  845.  
  846.     define_variable(info->module, name, var_Method);
  847.     queue_form(&State.top_level_forms, tlf);
  848.  
  849.     return name;
  850. }
  851.  
  852. static obj_t fop_define_constant(struct load_info *info)
  853. {
  854.     int num_names = fixnum_value(read_thing(info));
  855.     int i;
  856.  
  857.     for (i = 0; i < num_names; i++)
  858.     define_variable(info->module, read_thing(info), var_Constant);
  859.     return queue_form(&State.top_level_forms, read_thing(info));
  860. }
  861.  
  862. static obj_t fop_define_variable(struct load_info *info)
  863. {
  864.     int num_names = fixnum_value(read_thing(info));
  865.     int i;
  866.  
  867.     for (i = 0; i < num_names; i++)
  868.     define_variable(info->module, read_thing(info), var_Variable);
  869.     return queue_form(&State.top_level_forms, read_thing(info));
  870. }
  871.  
  872. static struct defn *read_defn(struct load_info *info, boolean read_creates)
  873. {
  874.     struct defn *defn = malloc(sizeof(struct defn));
  875.     struct use *use, **prev;
  876.     obj_t name;
  877.  
  878.     defn->name = read_thing(info);
  879.     prev = &defn->use;
  880.     while ((name = read_thing(info)) != obj_False) {
  881.     use = malloc(sizeof(struct use));
  882.     use->name = name;
  883.     use->import = read_thing(info);
  884.     use->exclude = read_thing(info);
  885.     use->prefix = read_thing(info);
  886.     use->rename = read_thing(info);
  887.     use->export = read_thing(info);
  888.     *prev = use;
  889.     prev = &use->next;
  890.     }
  891.     *prev = NULL;
  892.     defn->exports = read_thing(info);
  893.     if (read_creates)
  894.     defn->creates = read_thing(info);
  895.     else
  896.     defn->creates = obj_Nil;
  897.  
  898.     return defn;
  899. }
  900.  
  901. static obj_t fop_define_library(struct load_info *info)
  902. {
  903.     struct defn *defn = read_defn(info, FALSE);
  904.  
  905.     define_library(defn);
  906.  
  907.     return defn->name;
  908. }
  909.  
  910. static obj_t fop_define_module(struct load_info *info)
  911. {
  912.     struct defn *defn = read_defn(info, TRUE);
  913.  
  914.     define_module(info->library, defn);
  915.  
  916.     return defn->name;
  917. }
  918.  
  919. static obj_t fop_done(struct load_info *info)
  920. {
  921.     info->done = TRUE;
  922.     return obj_False;
  923. }
  924.  
  925.  
  926. /* Interface routines. */
  927.  
  928. static void skip_header(struct load_info *info)
  929. {
  930.     int c;
  931.  
  932.     while ((c = read_byte(info)) == '#')
  933.     while ((c = read_byte(info)) != '\n')
  934.         ;
  935.  
  936.     if (c != fop_HEADER)
  937.     error("Invalid .dbc file: %s", make_string(info->name));
  938.  
  939.     unread_byte(info);
  940. }
  941.  
  942. static void load_group(struct load_info *info)
  943. {
  944.     info->done = FALSE;
  945.     info->next_handle = 0;
  946.  
  947.     skip_header(info);
  948.  
  949.     while (!info->done)
  950.     read_thing(info);
  951. }
  952.  
  953. struct load_info *make_load_info(char *name, int fd)
  954. {
  955.     struct load_info *info
  956.     = (struct load_info *)malloc(sizeof(struct load_info));
  957.  
  958.     info->name = name;
  959.     info->fd = fd;
  960.     info->buffer = (unsigned char *)malloc(BUFFER_SIZE);
  961.     info->ptr = info->end = info->buffer;
  962.     info->table = info->table_end = 0;
  963.     info->swap_bytes = FALSE;
  964.     info->done = FALSE;
  965.     info->library = NULL;
  966.     info->module = NULL;
  967.     info->mtime = make_fixnum(0);
  968.     info->source_file = obj_False;
  969.  
  970.     return info;
  971. }
  972.  
  973. static void free_load_info(struct load_info *info)
  974. {
  975.     if (info->table)
  976.     free(info->table);
  977.     free(info->buffer);
  978.     free(info);
  979. }
  980.  
  981. void load(char *name)
  982. {
  983.     int fd = open(name, O_RDONLY, 0);
  984.     struct load_info *info;
  985.  
  986.     if (fd < 0)
  987.     error("Error loading %s: %s\n",
  988.           make_string(name),
  989. #ifndef sparc
  990.           make_string(strerror(errno)));
  991. #else
  992.               make_string(sys_errlist[errno]));
  993. #endif
  994.  
  995.     info = make_load_info(name, fd);
  996.  
  997.     while (1) {
  998.     load_group(info);
  999.     if (info->ptr == info->end) {
  1000.         int count = read(fd, info->buffer, BUFFER_SIZE);
  1001.         if (count < 0)
  1002.         error("error loading %s: %s",
  1003.               make_string(name),
  1004. #ifndef sparc
  1005.               make_string(strerror(errno)));
  1006. #else
  1007.                       make_string(sys_errlist[errno]));
  1008. #endif
  1009.         if (count == 0)
  1010.         break;
  1011.         info->ptr = info->buffer;
  1012.         info->end = info->ptr + count;
  1013.     }
  1014.     }
  1015.     close(info->fd);
  1016.     free_load_info(info);
  1017. }
  1018.  
  1019.  
  1020. /* Library loading. */
  1021.  
  1022. void load_library(obj_t name)
  1023. {
  1024.     char *load_path = getenv("MINDYPATH");
  1025.     char path[MAXPATHLEN];
  1026.     char *start, *ptr, *src, *dst;
  1027.     int c;
  1028.  
  1029.     if (load_path == NULL)
  1030.     load_path = DEFAULT_LOAD_PATH;
  1031.  
  1032.     start = load_path;
  1033.     ptr = load_path;
  1034.     do {
  1035.     c = *ptr;
  1036.     if (c == ':' || c == '\0') {
  1037.         int len = ptr - start;
  1038.         if (len) {
  1039.         memcpy(path, start, len);
  1040.         path[len++] = '/';
  1041.         }
  1042.         dst = path+len;
  1043.         for (src = sym_name(name); *src != '\0'; src++)
  1044.         if (isupper(*src))
  1045.             *dst++ = tolower(*src);
  1046.         else
  1047.             *dst++ = *src;
  1048.         strcpy(dst, ".dbc");
  1049.         if (access(path, R_OK) == 0) {
  1050.         load(path);
  1051.         return;
  1052.         }
  1053.         start = ptr+1;
  1054.     }
  1055.     ptr++;
  1056.     } while (c != '\0');
  1057.  
  1058.     error("Can't find library %=", name);
  1059. }
  1060.  
  1061.  
  1062. /* Stuff to run the inits. */
  1063.  
  1064. static void do_next_init(struct thread *thread);
  1065.  
  1066. static void did_form(struct thread *thread, obj_t *vals)
  1067. {
  1068.     thread->sp = vals;
  1069.     do_next_init(thread);
  1070. }
  1071.  
  1072. static void do_next_init(struct thread *thread)
  1073. {
  1074.     if (State.everything.head) {
  1075.     struct form *tlf = State.everything.head;
  1076.     State.everything.head = tlf->next;
  1077.  
  1078.     *thread->sp++ = tlf->method;
  1079.  
  1080.     free(tlf);
  1081.  
  1082.     set_c_continuation(thread, did_form);
  1083.     invoke(thread, 0);
  1084.     }
  1085.     else
  1086.     do_return(thread, pop_linkage(thread), thread->sp);
  1087. }
  1088.  
  1089. static void do_first_init(struct thread *thread, int nargs)
  1090. {
  1091.     *State.classes.tail = State.top_level_forms.head;
  1092.     State.top_level_forms.head = NULL;
  1093.     State.top_level_forms.tail = NULL;
  1094.  
  1095.     *State.everything.tail = State.classes.head;
  1096.     State.classes.head = NULL;
  1097.     State.classes.tail = NULL;
  1098.  
  1099.     assert(nargs == 0);
  1100.     push_linkage(thread, thread->sp);
  1101.     do_next_init(thread);
  1102. }
  1103.  
  1104. void load_do_inits(struct thread *thread)
  1105. {
  1106.     *thread->sp++ = make_raw_function("init", 0, FALSE, obj_False, FALSE,
  1107.                       obj_Nil, obj_ObjectClass,
  1108.                       do_first_init);
  1109.     invoke(thread, 0);
  1110. }
  1111.  
  1112.  
  1113. /* GC hooks */
  1114.  
  1115. void scavenge_load_roots(void)
  1116. {
  1117.     struct form *tlf;
  1118.  
  1119.     for (tlf = State.everything.head; tlf != NULL; tlf = tlf->next)
  1120.     scavenge(&tlf->method);
  1121.     for (tlf = State.classes.head; tlf != NULL; tlf = tlf->next)
  1122.     scavenge(&tlf->method);
  1123.     for (tlf = State.top_level_forms.head; tlf != NULL; tlf = tlf->next)
  1124.     scavenge(&tlf->method);
  1125. }
  1126.  
  1127.  
  1128. /* Init stuff. */
  1129.  
  1130. void init_loader(void)
  1131. {
  1132.     int i;
  1133.  
  1134.     for (i = 0; i < 256; i++)
  1135.     opcodes[i] = fop_flame;
  1136.  
  1137.     opcodes[fop_HEADER] = fop_header;
  1138.     opcodes[fop_STORE] = fop_store;
  1139.     opcodes[fop_SHORT_REF] = fop_short_ref;
  1140.     opcodes[fop_REF] = fop_ref;
  1141.     opcodes[fop_FALSE] = fop_false;
  1142.     opcodes[fop_TRUE] = fop_true;
  1143.     opcodes[fop_UNBOUND] = fop_unbound;
  1144.     opcodes[fop_SIGNED_BYTE] = fop_signed_byte;
  1145.     opcodes[fop_SIGNED_SHORT] = fop_signed_short;
  1146.     opcodes[fop_SIGNED_INT] = fop_signed_int;
  1147.     opcodes[fop_SIGNED_LONG] = fop_signed_long;
  1148.     opcodes[fop_CHAR] = fop_char;
  1149.     opcodes[fop_SINGLE_FLOAT] = fop_single_float;
  1150.     opcodes[fop_DOUBLE_FLOAT] = fop_double_float;
  1151.     opcodes[fop_EXTENDED_FLOAT] = fop_extended_float;
  1152.     opcodes[fop_SHORT_STRING] = fop_short_string;
  1153.     opcodes[fop_STRING] = fop_string;
  1154.     opcodes[fop_SHORT_SYMBOL] = fop_short_symbol;
  1155.     opcodes[fop_SYMBOL] = fop_symbol;
  1156.     opcodes[fop_NIL] = fop_nil;
  1157.     opcodes[fop_LIST1] = fop_list1;
  1158.     opcodes[fop_LIST2] = fop_list2;
  1159.     opcodes[fop_LIST3] = fop_list3;
  1160.     opcodes[fop_LIST4] = fop_list4;
  1161.     opcodes[fop_LIST5] = fop_list5;
  1162.     opcodes[fop_LIST6] = fop_list6;
  1163.     opcodes[fop_LIST7] = fop_list7;
  1164.     opcodes[fop_LIST8] = fop_list8;
  1165.     opcodes[fop_LISTN] = fop_listn;
  1166.     opcodes[fop_DOTTED_LIST1] = fop_dotted_list1;
  1167.     opcodes[fop_DOTTED_LIST2] = fop_dotted_list2;
  1168.     opcodes[fop_DOTTED_LIST3] = fop_dotted_list3;
  1169.     opcodes[fop_DOTTED_LIST4] = fop_dotted_list4;
  1170.     opcodes[fop_DOTTED_LIST5] = fop_dotted_list5;
  1171.     opcodes[fop_DOTTED_LIST6] = fop_dotted_list6;
  1172.     opcodes[fop_DOTTED_LIST7] = fop_dotted_list7;
  1173.     opcodes[fop_DOTTED_LIST8] = fop_dotted_list8;
  1174.     opcodes[fop_DOTTED_LISTN] = fop_dotted_listn;
  1175.     opcodes[fop_VECTOR0] = fop_vector0;
  1176.     opcodes[fop_VECTOR1] = fop_vector1;
  1177.     opcodes[fop_VECTOR2] = fop_vector2;
  1178.     opcodes[fop_VECTOR3] = fop_vector3;
  1179.     opcodes[fop_VECTOR4] = fop_vector4;
  1180.     opcodes[fop_VECTOR5] = fop_vector5;
  1181.     opcodes[fop_VECTOR6] = fop_vector6;
  1182.     opcodes[fop_VECTOR7] = fop_vector7;
  1183.     opcodes[fop_VECTOR8] = fop_vector8;
  1184.     opcodes[fop_VECTORN] = fop_vectorn;
  1185.     opcodes[fop_VALUE_CELL] = fop_value_cell;
  1186.     opcodes[fop_WRITABLE_VALUE_CELL] = fop_writable_value_cell;
  1187.     opcodes[fop_BUILTIN_VALUE_CELL] = fop_builtin_value_cell;
  1188.     opcodes[fop_BUILTIN_WRITABLE_VALUE_CELL] = fop_builtin_writable_value_cell;
  1189.     opcodes[fop_SHORT_COMPONENT] = fop_short_component;
  1190.     opcodes[fop_COMPONENT] = fop_component;
  1191.     opcodes[fop_METHOD] = fop_method;
  1192.     opcodes[fop_SHORT_METHOD] = fop_short_method;
  1193.     opcodes[fop_IN_LIBRARY] = fop_in_library;
  1194.     opcodes[fop_IN_MODULE] = fop_in_module;
  1195.     opcodes[fop_SOURCE_FILE] = fop_source_file;
  1196.     opcodes[fop_TOP_LEVEL_FORM] = fop_top_level_form;
  1197.     opcodes[fop_DEFINE_CONSTANT] = fop_define_constant;
  1198.     opcodes[fop_DEFINE_VARIABLE] = fop_define_variable;
  1199.     opcodes[fop_DEFINE_GENERIC] = fop_define_generic;
  1200.     opcodes[fop_DEFINE_METHOD] = fop_define_method;
  1201.     opcodes[fop_DEFINE_CLASS] = fop_define_class;
  1202.     opcodes[fop_DEFINE_LIBRARY] = fop_define_library;
  1203.     opcodes[fop_DEFINE_MODULE] = fop_define_module;
  1204.     opcodes[fop_DONE] = fop_done;
  1205.  
  1206.     State.everything.head = NULL;
  1207.     State.everything.tail = &State.everything.head;
  1208.     State.classes.head = NULL;
  1209.     State.classes.tail = &State.classes.head;
  1210.     State.top_level_forms.head = NULL;
  1211.     State.top_level_forms.tail = &State.top_level_forms.head;
  1212. }
  1213.